## Perspective Taking and Security Dilemma Thinking: replication data
#Kertzer, Brutger and Quek
#October 1, 2023

####### SCS Replication 3.R: this R file contains the code necessary to run the perspective taking experiment analysis in the main text - run SCS Replication 1.R first!
# All of the following analyses were carried out using R version 4.3.1 GUI 1.77 (Big Sur ARM build 8238) on an M1 Pro Macbook Pro running MacOS Ventura. 

##### Figure 4: Effects of treatments on policy preferences

set.seed(43215)
B <- 1500

tab1a <- matrix(NA, B, 4)
for (i in 1:B){
	j <- sample(1:nrow(usa1), nrow(usa1), replace=TRUE)
	temp <- usa1[j,]
	tab1a[i,1] <- mean(temp$policyChoice[which(temp$ch_incr==0 & temp$PT==0)], na.rm=TRUE)
	tab1a[i,2] <- mean(temp$policyChoice[which(temp$ch_incr==0 & temp$PT==1)], na.rm=TRUE)
	tab1a[i,3] <- mean(temp$policyChoice[which(temp$ch_incr==1 & temp$PT==0)], na.rm=TRUE)
	tab1a[i,4] <- mean(temp$policyChoice[which(temp$ch_incr==1 & temp$PT==1)], na.rm=TRUE)	
}

tab1b <- matrix(NA, B, 4)
for (i in 1:B){
	j <- sample(1:nrow(china1), nrow(china1), replace=TRUE)
	temp <- china1[j,]
	tab1b[i,1] <- mean(temp$policyChoice[which(temp$am_incr==0 & temp$PT==0)], na.rm=TRUE)
	tab1b[i,2] <- mean(temp$policyChoice[which(temp$am_incr==0 & temp$PT==1)], na.rm=TRUE)
	tab1b[i,3] <- mean(temp$policyChoice[which(temp$am_incr==1 & temp$PT==0)], na.rm=TRUE)
	tab1b[i,4] <- mean(temp$policyChoice[which(temp$am_incr==1 & temp$PT==1)], na.rm=TRUE)	
}

tab3 <- as.data.frame(rbind(cbind(apply(tab1a, 2, mean, na.rm=TRUE), apply(tab1a, 2, quantile, 0.025, na.rm=TRUE), apply(tab1a, 2, quantile, 0.975,na.rm=TRUE)), cbind(apply(tab1b, 2, mean, na.rm=TRUE), apply(tab1b, 2, quantile, 0.025, na.rm=TRUE), apply(tab1b, 2, quantile, 0.975,na.rm=TRUE))))
colnames(tab3) <- c("X", "Low", "High")
tab3$Sample <- rep(c("USA", "China"), each=4)
tab3$Behavior <- rep(rep(c("Other side de-escalates", "Other side escalates"),each=2),2)
tab3$PT <- rep(c("Control", "Perspective\nTaking"),4)
tab3$z <- rep(1:4,2)
tab3$pair <- rep(1:4, each=2)


fig4 <- ggplot(data=tab3, aes(x=PT,y=X, color=Sample, shape=Sample)) + geom_point() + geom_segment(aes(x=PT, y=Low, xend=PT, yend=High)) + theme_bw() + facet_wrap(~ Behavior) + geom_line(aes(x=PT, y=X, group=Sample, alpha=0.8)) + labs(y="Policy preferences", x="") + guides(alpha="none") + ylim(3,7) + scale_colour_brewer(palette="Set1")
ggsave(file="fig4.pdf", plot=fig4, height=4.5, width=8, units="in")

#Calculate p-values for annotations
t.test(policyChoice ~PT, data=subset(usa1, usa1$ch_incr==0)) #p < 0.018
t.test(policyChoice ~PT, data=subset(usa1, usa1$ch_incr==1)) #p < 0.631
t.test(policyChoice ~PT, data=subset(china1, china1$am_incr==0)) #p < 0.037
t.test(policyChoice ~PT, data=subset(china1, china1$am_incr==1)) #p < 0.017

### Quantities described in the text

#Baseline preference:
mean(china1$policyChoice, na.rm=TRUE) - mean(usa1$policyChoice, na.rm=TRUE) #1.07 point difference
base.df <- data.frame(policyChoice=c(usa1$policyChoice, china1$policyChoice), natAboutYou=c(usa1$natAboutYou,china1$natAboutYou),sample=c(rep("USA", nrow(usa1)), rep("China", nrow(china1))))
t.test(policyChoice ~ sample, data=base.df) #p < 0.001

#Escalation treatment
mean(usa1$policyChoice[which(usa1$ch_incr==1)], na.rm=TRUE) - mean(usa1$policyChoice[which(usa1$ch_incr==0)], na.rm=TRUE) #0.50 point difference
mean(china1$policyChoice[which(china1$am_incr==1)], na.rm=TRUE) - mean(china1$policyChoice[which(china1$am_incr==0)], na.rm=TRUE) #0.59 point difference

t.test(policyChoice ~ ch_incr, data=usa1) #p < 0.001
t.test(policyChoice ~ am_incr, data=china1) #p < 0.001

#Perspective taking treatment
mean(usa1$policyChoice[which(usa1$ch_incr==0 & usa1$PT==1)], na.rm=TRUE) - mean(usa1$policyChoice[which(usa1$ch_incr==0 & usa1$PT==0)], na.rm=TRUE) #-0.27 point difference
t.test(policyChoice ~ PT, data=usa1[which(usa1$ch_incr==0),]) #p < 0.018

mean(china1$policyChoice[which(china1$am_incr==0 & china1$PT==1)], na.rm=TRUE) - mean(china1$policyChoice[which(china1$am_incr==0 & china1$PT==0)], na.rm=TRUE) #0.23 point difference
t.test(policyChoice ~ PT, data=china1[which(china1$am_incr==0),]) #p < 0.037

mean(china1$policyChoice[which(china1$am_incr==1 & china1$PT==1)], na.rm=TRUE) - mean(china1$policyChoice[which(china1$am_incr==1 & china1$PT==0)], na.rm=TRUE) #-0.23 point difference
t.test(policyChoice ~ PT, data=china1[which(china1$am_incr==1),]) #p < 0.017

#Nationalism
t.test(natAboutYou~sample, data=base.df) #t=12.99, p < 0.001

##### Figure 5: Testing the identity threat mechanism 
fig5a <- ggplot(base.df, aes(y=natAboutYou, x=sample)) + geom_violin(aes(fill=sample), alpha=0.8) + theme_bw() + labs(y="National Attachment", x="Sample") + scale_fill_hue(h=c(10,250)) + geom_boxplot(notch=FALSE, na.rm=TRUE, width=0.15) + theme(legend.position="none")
ggsave(file="fig5a.pdf", plot=fig5a, height=4,width=4, units="in")

set.seed(43215)
us.0c <- interflex(data=as.data.frame(subset(usa1, usa1$ch_incr==0)), Y="policyChoice", D="PT", X="natAboutYou", Z=c("male", "age", "White", "educ", "pid1"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
us.1c <- interflex(data=as.data.frame(subset(usa1, usa1$ch_incr==1)), Y="policyChoice", D="PT", X="natAboutYou", Z=c("male", "age", "White", "educ", "pid1"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
cn.0c <- interflex(data=as.data.frame(subset(china1, china1$am_incr==0)), Y="policyChoice", D="PT", X="natAboutYou", Z=c("male", "educ", "age", "Han","partyMember"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
cn.1c <- interflex(data=as.data.frame(subset(china1, china1$am_incr==1)), Y="policyChoice", D="PT", X="natAboutYou", Z=c("male", "educ", "age", "Han","partyMember"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)

nat.df <- data.frame(X=c(us.0c$est.kernel[[1]][,"X"], us.1c$est.kernel[[1]][,"X"], cn.0c$est.kernel[[1]][,"X"], cn.1c$est.kernel[[1]][,"X"]), Y=c(us.0c$est.kernel[[1]][,"TE"], us.1c$est.kernel[[1]][,"TE"], cn.0c$est.kernel[[1]][,"TE"], cn.1c$est.kernel[[1]][,"TE"]), Low=c(us.0c$est.kernel[[1]][,"lower CI(95%)"], us.1c$est.kernel[[1]][,"lower CI(95%)"], cn.0c$est.kernel[[1]][,"lower CI(95%)"], cn.1c$est.kernel[[1]][,"lower CI(95%)"]), High=c(us.0c$est.kernel[[1]][,"upper CI(95%)"], us.1c$est.kernel[[1]][,"upper CI(95%)"], cn.0c$est.kernel[[1]][,"upper CI(95%)"], cn.1c$est.kernel[[1]][,"upper CI(95%)"]), Country=rep(c("USA", "China"), each=100), Escalation=rep(c("Other side de-escalates", "Other side escalates"), each=50))

fig5b <- ggplot(data=nat.df, aes(x=X, y=Y)) + geom_line() + geom_ribbon(aes(ymin=Low, ymax=High), fill="grey70", alpha=0.5) + facet_grid(Country~Escalation, scales="free") + theme_bw() + geom_hline(yintercept=0, linetype=3, alpha=0.5) + labs(x="National Attachment", y="Marginal Effect of Perspective-Taking") 
ggsave(file="fig5b.pdf", plot=fig5b, height=4,width=4.2, units="in")

#### Figure 6: Testing the negative goal interdependence mechanism

set.seed(43215)
us.i.0c <- interflex(data=as.data.frame(subset(usa1, usa1$ch_incr==0)), Y="policyChoice", D="PT", X="imgNegInt1", Z=c("male", "age", "White", "educ", "pid1"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
us.i.1c <- interflex(data=as.data.frame(subset(usa1, usa1$ch_incr==1)), Y="policyChoice", D="PT", X="imgNegInt1", Z=c("male", "age", "White", "educ", "pid1"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
cn.i.0c <- interflex(data=as.data.frame(subset(china1, china1$am_incr==0)), Y="policyChoice", D="PT", X="imgNegInt1", Z=c("male", "educ", "age", "Han","partyMember"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)
cn.i.1c <- interflex(data=as.data.frame(subset(china1, china1$am_incr==1)), Y="policyChoice", D="PT", X="imgNegInt1", Z=c("male", "educ", "age", "Han","partyMember"), estimator="kernel", treat.type="discrete", base=0, na.rm=TRUE, nboots=1000, parallel=TRUE, cores=10)

intention.df <- data.frame(X=c(us.i.0c$est.kernel[[1]][,"X"], us.i.1c$est.kernel[[1]][,"X"], cn.i.0c$est.kernel[[1]][,"X"], cn.i.1c$est.kernel[[1]][,"X"]), Y=c(us.i.0c$est.kernel[[1]][,"TE"], us.i.1c$est.kernel[[1]][,"TE"], cn.i.0c$est.kernel[[1]][,"TE"], cn.i.1c$est.kernel[[1]][,"TE"]), Low=c(us.i.0c$est.kernel[[1]][,"lower CI(95%)"], us.i.1c$est.kernel[[1]][,"lower CI(95%)"], cn.i.0c$est.kernel[[1]][,"lower CI(95%)"], cn.i.1c$est.kernel[[1]][,"lower CI(95%)"]), High=c(us.i.0c$est.kernel[[1]][,"upper CI(95%)"], us.i.1c$est.kernel[[1]][,"upper CI(95%)"], cn.i.0c$est.kernel[[1]][,"upper CI(95%)"], cn.i.1c$est.kernel[[1]][,"upper CI(95%)"]), Country=rep(c("USA", "China"), each=100), Escalation=rep(c("Other side de-escalates", "Other side escalates"), each=50))

fig6 <- ggplot(data=intention.df, aes(x=X, y=Y)) + geom_line() + geom_ribbon(aes(ymin=Low, ymax=High), fill="grey70", alpha=0.5) + facet_grid(Country~Escalation, scales="free") + theme_bw() + geom_hline(yintercept=0, linetype=3, alpha=0.5) + labs(x="Image of Other: Negative Intentions", y="Marginal Effect of Perspective-Taking") 
ggsave(file="fig6.pdf", plot=fig6, height=4,width=4.2, units="in")

#Quantities in text
usa1$goodIntentions <- ifelse(usa1$imgNegInt1<=0.5,1,0) #Look at Americans who attribute negative intentions to China
mod.0 <- lm(policyChoice ~ PT*goodIntentions + male + age + White + educ + pid1, data=as.data.frame(subset(usa1, usa1$ch_incr==0)))
summary(mod.0) #p < 0.078 for interaction

china1$goodIntentions <- ifelse(china1$imgNegInt1<0.5,1,0) #Look at Chinese who attribute negative intentions to US
mod.3 <- lm(policyChoice ~ PT*goodIntentions + male + educ + age+ Han + partyMember, data=as.data.frame(subset(china1, china1$am_incr==1)))
summary(mod.3) #p < 0.037 for interaction

#### Figure 7: Security dilemma thinking mitigates the palliative effects of perspective taking

set.seed(43125)
mod.attr0c <- interflex(Y="policyChoice", D="PT", X="attrBias", Z=c("male", "age", "White", "educ", "pid1"), data=as.data.frame(subset(usa1, usa1$ch_incr==0)), base=0, nboots=1000, na.rm=TRUE, parallel=TRUE, cores=10, estimator="kernel")
mod.attr1c <- interflex(Y="policyChoice", D="PT", X="attrBias", Z=c("male", "educ", "age", "Han","partyMember"), data=as.data.frame(subset(china1, china1$am_incr==0)), base=0, nboots=1000, na.rm=TRUE,parallel=TRUE, cores=10, estimator="kernel")

mat.attrc <- as.data.frame(cbind(rbind(mod.attr0c$est.kernel[[1]], mod.attr1c$est.kernel[[1]])))
colnames(mat.attrc) <- c("X","ME","sd","CI_lower","CI_upper")
mat.attrc$Country <- rep(c("USA", "China"),each=50)
mat.attrc$Escalation <- "Other side de-escalates"

fig7 <- ggplot(data=mat.attrc, aes(x=X, y=ME)) + geom_line() + geom_ribbon(aes(ymin=CI_lower, ymax=CI_upper), fill="grey70", alpha=0.5) + facet_grid(Escalation~Country, scales="free") + theme_bw() + geom_hline(yintercept=0, linetype=3, alpha=0.5) + labs(x="Attribution Asymmetry", y="Marginal Effect of Perspective Taking") 
ggsave(file="fig7.pdf", plot=fig7, height=3.25, width=6)

#Quantities of interest in text
mod.0 <- lm(policyChoice ~ PT*attrBias + male + age + White + educ + pid1, data=as.data.frame(subset(usa1, usa1$ch_incr==0)))
summary(mod.0) # p < 0.007 for interaction

mod.1 <- lm(policyChoice ~ PT*attrBias + male + educ + age + Han + partyMember, data=as.data.frame(subset(china1, china1$am_incr==0)))
summary(mod.1) # p < 0.004 for interaction

######## Effects of perspective taking on policy reasoning

## US data
#Produce slimmer dataframe
us.dat <- usa1[c("policyChoice", "ch_incr", "PT", "policyExpl")]
meta.data <- usa1[c("policyChoice", "ch_incr", "PT")]

docs1 <- usa1[c("policyExpl")]
Corpus <- Corpus(VectorSource(usa1$policyExpl))

#Clean corpus
Corpus.clean <- tm_map(Corpus, stripWhitespace)
Corpus.clean <- tm_map(Corpus.clean, removePunctuation)
Corpus.clean <- tm_map(Corpus.clean, tolower)
dataframe<-data.frame(text=unlist(sapply(Corpus.clean, `[`)), stringsAsFactors=F)

clean.data <- cbind(meta.data, dataframe)

## Remove offending characters that cause errors
for(i in 1:nrow(clean.data)){
  clean.data$text[i] <- gsub("[^[:alnum:]///' ]", "", clean.data$text[i])
}

#Effect of PT treatment, in China de-escalates condition
decr.dat <- subset(clean.data, clean.data$ch_incr==0)

processed <- textProcessor(decr.dat$text, metadata=decr.dat)
out <- prepDocuments(processed$documents, processed$vocab, processed$meta)

#5 topic solution
decr.mod <- selectModel(processed$documents, processed$vocab, K=5, prevalence = ~ PT, max.em.its = 300, runs=20, data = processed$meta, seed = 43215, init.type="Spectral")

decr.mod1 <- decr.mod$runout[[4]]

decr.mod1.effect <-  estimateEffect(1:5 ~ PT, decr.mod1, meta=processed$meta, uncertainty = "Global")

#Figure 8a (add label in postproduction)
dev.new(height=7, width=7)
plot(decr.mod1.effect, covariate="PT", method="difference", cov.value1=1, cov.value2=0, topics=4, xlim=c(-0.1,0.1), xlab="Change in topical prevalence from control to PT") #Topic 4: Reciprocity

#Quotes for Figure 8b
## Note "findThoughts" gives us the "cleaned" version of open-ended responses
## The version in the paper is the original, as typed by the respondent
findThoughts(decr.mod1, texts=processed$meta$text, topics=4, n=10) 
#Topics are about reciprocity, acknowledging China's signal

### Chinese data
Sys.setlocale(category = "LC_CTYPE", locale = "zh_CN.utf-8")
#Produce slimmer dataframe
cn.dat <- china1[c("policyChoice", "am_incr", "PT", "policyExpl")]

#Preprocess using jieba
require(jiebaR)
cn.dat$seg_policyExpl <- segment(cn.dat$policyExpl, worker(bylines = TRUE))
cn.dat$seg_policyExpl <- gsub("^c\\(|\\)$", "", cn.dat$seg_policyExpl) # clear 'c(' in the beginning and ')' in the end of the string
cn.dat$seg_policyExpl <- gsub(", ", " ", cn.dat$seg_policyExpl) # remove ,
cn.dat$seg_policyExpl <- gsub('"', '', cn.dat$seg_policyExpl) # remove "

#Address missingness and observations that use English letters but Chinese text

#Drop two missing observations 
cn.dat <- cn.dat[!is.na(cn.dat$am_incr),]

#Drop observations that use random English letters/phrases
j <- c(76,104,153,219,317,319,449,549,605,651,703,758,781,833,865,962,1181,1190,1208,1212)

cn.dat$seg_policyExpl[j] <- NA

metadata.CN <- cn.dat[!is.na(cn.dat$am_incr),] #Define metadata
expl0.CN <- textProcessor(cn.dat$seg_policyExpl[which(cn.dat$am_incr==0)], metadata=metadata.CN[which(cn.dat$am_incr==0),], lowercase=FALSE, removestopwords = FALSE, removenumbers = TRUE, removepunctuation = TRUE, stem=FALSE, language="na") #Create corpus
expl.CN0p <- prepDocuments(expl0.CN$documents, expl0.CN$vocab, meta=expl0.CN$meta) #Finish corpus, removing low-frequency terms

mod.expl.pt0p <- selectModel(expl.CN0p$documents, expl.CN0p$vocab, K=5, prevalence = ~ PT, max.em.its=300, runs=20, data=expl.CN0p$meta, init.type="Spectral", seed=43215) #5 topic solution

o.expl.pt0p <- mod.expl.pt0p$runout[[1]]

expl.pt0p.effect <- estimateEffect(1:5 ~ PT, o.expl.pt0p, meta=expl.CN0p$meta, uncertainty="Global")

#Figure 9a (add labels in postproduction)
plot(expl.pt0p.effect, covariate="PT", topics=c(2,5), method="difference", cov.value1=1, cov.value2=0, xlab="Change in topical prevalence from PT to control") 
#Topics 2 and 5: standing firm, emphasizing moderation

#Quotes for Figure 9b (show translated version)
o.expl.pt0p.thoughts2 <- findThoughts(o.expl.pt0p, texts=expl.CN0p$meta$policyExpl, topics=2, n=10)
o.expl.pt0p.thoughts2
#Standing firm, protecting the status quo

#Quotes for Figure 9c (show translated version)
o.expl.pt0p.thoughts5 <- findThoughts(o.expl.pt0p, texts=expl.CN0p$meta$policyExpl, topics=5, n=10)
o.expl.pt0p.thoughts5
#Showing moderation
